home *** CD-ROM | disk | FTP | other *** search
/ Ahoy 1985 May / Ahoy_Magazine_85-05_1985_Double_L.d64 / font editor (.txt) < prev    next >
Commodore BASIC  |  2022-10-26  |  8KB  |  326 lines
  1. 10 rem commodore font editor
  2. 20 rem programmed by stephen reed
  3. 30 rem
  4. 40 rem if you don't want to type in
  5. 50 rem this program, copies are
  6. 60 rem available on disk with several
  7. 70 rem character fonts. send $12.95 to:
  8. 80 rem
  9. 90 rem       font editor
  10. 100 rem      2404 s. myrtle ave.
  11. 110 rem      sanford, fl  32707
  12. 120 rem
  13. 130 rem
  14. 140 rem ***************************
  15. 150 rem * initialize program data *
  16. 160 rem ***************************
  17. 170 rem
  18. 180 poke53281,1:poke53280,7
  19. 190 poke52,48:poke56,48:clr:dimr$(7)
  20. 200 fora=0to7:readr(a):nexta
  21. 210 data 128,64,32,16,8,4,2,1
  22. 220 print"[147]"chr$(142)chr$(8)"";
  23. 230 cc=1:oc=1
  24. 240 print"         commodore font editor         [160]";
  25. 250 print"[144][163][163][163][163][163][163][163][163][163][163][163][163][163][163][163][163][163][163][163][163][163][163][163][163][163][163][163][163][163][163][163][163][163][163][163][163][163][163][163][163]"
  26. 260 gosub510:rem get e window
  27. 270 gosub740:rem menu on screen
  28. 280 gosub920:rem display characters
  29. 290 gosub1070:rem update scrn for cc
  30. 300 ifpeek(12288)=60then430
  31. 310 rem
  32. 320 rem ***************************
  33. 330 rem * download rom characters *
  34. 340 rem ***************************
  35. 350 rem
  36. 360 print"";o$;"please wait 30 seconds"
  37. 370 poke56334,peek(56334)and254
  38. 380 poke1,peek(1)and251
  39. 390 fora=0to2047
  40. 400 pokea+12288,peek(a+53248):next
  41. 410 poke1,peek(1)or4
  42. 420 poke56334,peek(56334)or1:gosub1070
  43. 430 gosub740
  44. 440 poke53272,(peek(53272)and240)+12
  45. 450 gosub1390:ifa$<"0"ora$>"9"then450
  46. 460 a=val(a$):ifa=0thena=10
  47. 470 onagosub1700,1890,2070,2430,2620,2750,2920,3010,3170,3240
  48. 480 goto 450
  49. 490 rem
  50. 500 rem ******************************
  51. 510 rem * put edit window on screen  *
  52. 520 rem ******************************
  53. 530 rem
  54. 540 print" [144]";
  55. 550 print"   12345678   "
  56. 560 print"  [156][205]          [206][144] "
  57. 570 print"  [156] [205]        [206] [144] "
  58. 580 print" 1[156]  [146]          [144]1"
  59. 590 print" 2[156]  [146]          [144]2"
  60. 600 print" 3[156]  [146]          [144]3"
  61. 610 print" 4[156]  [146]          [144]4"
  62. 620 print" 5[156]  [146]          [144]5"
  63. 630 print" 6[156]  [146]          [144]6"
  64. 640 print" 7[156]  [146]          [144]7"
  65. 650 print" 8[156]  [146]          [144]8"
  66. 660 print"  [156] [206]        [205] [144] "
  67. 670 print"  [156][206]          [205][144] "
  68. 680 print"    12345678   [146]":return
  69. 690 rem
  70. 700 rem ***************************
  71. 710 rem * put main menu on screem *
  72. 720 rem ***************************
  73. 730 rem
  74. 740 print"*** menu ***[144]"
  75. 750 o$=""
  76. 760 print:printo$;"1] save font"
  77. 770 printo$;"2] load font"
  78. 780 printo$;"3] edit character"
  79. 790 printo$;"4] move characters"
  80. 800 printo$;"5] swap characters"
  81. 810 printo$;"6] inverse characters"
  82. 820 printo$;"7] get rom characters"
  83. 830 printo$;"8] display data values"
  84. 840 printo$;"9] decrement display"
  85. 850 printo$;"0] increment display"
  86. 860 print:printo$;"   select option?     ":return
  87. 870 rem
  88. 880 rem ******************************
  89. 890 rem * put character data on line *
  90. 900 rem ******************************
  91. 910 rem
  92. 920 print"";
  93. 930 print"                        ";
  94. 940 print"[144]@abcdefghijklmno";
  95. 950 print"pqrstuvwxyz[\]^_ !"+chr$(34)+"#$%&'()*+,-./01234567";
  96. 960 print"89:;<=>?[192][193][194][195][196][197][198][199][200][201][202][203][204][205][206][207][208][209][210][211][212][213][214][215][216][217][218][219][220][221][255][223]"
  97. 970 fora=94to255
  98. 980 poke1024+18*40+24+a,a
  99. 990 poke55296+18*40+24+a,0
  100. 1000 next
  101. 1010 printchr$(146):return
  102. 1020 rem
  103. 1030 rem ******************************
  104. 1040 rem * put current data on screen *
  105. 1050 rem ******************************
  106. 1060 rem
  107. 1070 poke55296+18*40+oc+24,0:oc=cc
  108. 1080 poke55296+18*40+cc+24,2
  109. 1090 print"[156]code ";right$(str$(cc),len(str$(cc))-1);
  110. 1100 ifcc<10thenprint"  "
  111. 1110 ifcc<100thenprint" "
  112. 1120 print"[146]";:fora=0to7:p$=""
  113. 1130 b=peek(12288+a+(cc*8))
  114. 1140 ifb=>128thenzp=1:b=b-128
  115. 1150 gosub1320
  116. 1160 ifb=>64thenzp=1:b=b-64
  117. 1170 gosub1320
  118. 1180 ifb=>32thenzp=1:b=b-32
  119. 1190 gosub1320
  120. 1200 ifb=>16thenzp=1:b=b-16
  121. 1210 gosub1320
  122. 1220 ifb=>8thenzp=1:b=b-8
  123. 1230 gosub1320
  124. 1240 ifb=>4thenzp=1:b=b-4
  125. 1250 gosub1320
  126. 1260 ifb=>2thenzp=1:b=b-2
  127. 1270 gosub1320
  128. 1280 ifb=1thenzp=1
  129. 1290 gosub1320
  130. 1300 print"[144]";p$:nexta
  131. 1310 return
  132. 1320 ifzp=1thenp$=p$+"[209]":zp=0:return
  133. 1330 p$=p$+" ":return
  134. 1340 rem
  135. 1350 rem ***************************
  136. 1360 rem * scan keyboard for input *
  137. 1370 rem ***************************
  138. 1380 rem
  139. 1390 geta$:ifa$=""then1390
  140. 1400 return
  141. 1410 rem
  142. 1420 rem ***************************
  143. 1430 rem *     erase menu area     *
  144. 1440 rem ***************************
  145. 1450 rem
  146. 1460 print"";
  147. 1470 fora=0to13
  148. 1480 printo$;"                      "
  149. 1490 nexta:return
  150. 1500 rem
  151. 1510 rem ***************************
  152. 1520 rem * formatted numeric input *
  153. 1530 rem ***************************
  154. 1540 rem
  155. 1550 print"[172][172][172][157][157][157]";:z=0:b$=""
  156. 1560 fora=1to3:gosub1600:ifz=1then1580
  157. 1570 next
  158. 1580 w=val(b$):ifw>255thenprint"[157][157][157]";:goto1550
  159. 1590 return
  160. 1600 gosub1390
  161. 1610 ifa$=chr$(13)thenz=1:return
  162. 1620 ifa$<"0"ora$>"9"then1600
  163. 1630 b$=b$+a$
  164. 1640 printa$;:return
  165. 1650 rem
  166. 1660 rem **************************
  167. 1670 rem * save font data to disk *
  168. 1680 rem **************************
  169. 1690 rem
  170. 1700 gosub1430
  171. 1710 print""o$"  ...save data...[144]"
  172. 1720 print:print""o$"filespec";
  173. 1730 inputn$:iflen(n$)>8then1700
  174. 1740 open 1,8,12,n$+",p,w"
  175. 1750 print#1,chr$(0)+chr$(48);
  176. 1760 fori=0to255
  177. 1770 print""o$"";i
  178. 1780 b$=""
  179. 1790 forj=0to7
  180. 1800 b$=b$+chr$(peek(12288+j+i*8)):next
  181. 1810 print#1,b$;
  182. 1820 nexti:close1:gosub1430
  183. 1830 gosub740:return
  184. 1840 rem
  185. 1850 rem ****************************
  186. 1860 rem * load font data from disk *
  187. 1870 rem ****************************
  188. 1880 rem
  189. 1890 gosub1430
  190. 1900 print""o$"  ...load data...[144]"
  191. 1910 print:print""o$"filespec";
  192. 1920 inputn$:iflen(n$)>8then1700
  193. 1930 open 1,8,12,n$+",p,r"
  194. 1940 get#1,a$,a$
  195. 1950 fori=0to255
  196. 1960 print""o$"";i
  197. 1970 forj=0to7
  198. 1980 get#1,a$:a=0:ifa$<>""thena=asc(a$)
  199. 1990 poke12288+j+i*8,a:nextj
  200. 2000 nexti:close1:gosub1430
  201. 2010 gosub740:return
  202. 2020 rem
  203. 2030 rem **************************
  204. 2040 rem * edit character routine *
  205. 2050 rem **************************
  206. 2060 rem
  207. 2070 gosub1430
  208. 2080 print""o$"[156]  edit character[144]"
  209. 2090 print:printo$"character # ";:gosub1550
  210. 2100 cc=w:gosub1070
  211. 2110 gosub1430:print""o$;"[156]edit character[144]"
  212. 2120 print:printo$"[e]      erase buffer"
  213. 2130 printo$"[*]/[.]  set pixel"
  214. 2140 printo$"[space]  reset pixel":printo$"[return] finished"
  215. 2150 print:print:printo$" cursor keys move"
  216. 2160 printo$" editing cursor."
  217. 2170 x=4:y=4:g=1:gosub2350
  218. 2180 gosub1390:ifa$="e"thengosub2410:goto2180
  219. 2190 ifa$=" "theng=3:gosub2350:goto2180
  220. 2200 ifa$="*"ora$="."theng=2:gosub2350:goto2180
  221. 2210 ifa$=chr$(13)then2280
  222. 2220 ifa$<>"[145]"anda$<>""anda$<>"[157]"anda$<>""then2180
  223. 2230 ifa$="[145]"andy>1theng=0:gosub2400:y=y-1:gosub2350:goto2180
  224. 2240 ifa$=""andy<8theng=0:gosub2400:y=y+1:gosub2350:goto2180
  225. 2250 ifa$=""andx<8theng=0:gosub2400:x=x+1:gosub2350:goto2180
  226. 2260 ifa$="[157]"andx>1theng=0:gosub2400:x=x-1:gosub2350:goto2180
  227. 2270 goto 2180
  228. 2280 fora=0to7
  229. 2290 gosub2320:rem get byte in b
  230. 2300 poke12288+(cc*8)+a,b:nexta
  231. 2310 gosub1070:gosub1430:gosub740:return
  232. 2320 b=0:forr=0to7
  233. 2330 u=peek(1268+(a*40)+r):ifu=87oru=81thenb=b+r(r)
  234. 2340 nextr:return
  235. 2350 x$="":y$="":print"";left$(x$,x);left$(y$,y);
  236. 2360 ifg=2thenprint"[144][209]":g=1:gosub2350:return
  237. 2370 ifg=3thenprint"[144] ":g=1:gosub2350:return
  238. 2380 k=peek(1227+x+y*40):ifk=81thenprint"[215]":return
  239. 2390 print"+":return
  240. 2400 poke1227+x+y*40,k:poke55499+x+y*40,0:return
  241. 2410 print"";:fora=1to8:print"        "
  242. 2420 nexta:g=1:k=32:gosub2350:return
  243. 2430 gosub1430
  244. 2440 print""o$"starting char ";
  245. 2450 gosub1550:m1=w
  246. 2460 print:printo$"ending char ";:gosub1550
  247. 2470 m2=w
  248. 2480 print:printo$"move to char ";:gosub1550
  249. 2490 ifm1>m2then2430
  250. 2500 ifw<=m2 andw=>m1 then 2430
  251. 2510 print:printo$;"  ...moving...[144]"
  252. 2520 fora=0to(m2-m1)
  253. 2530 forb=0to7
  254. 2540 poke12288+b+(a+w)*8,peek(12288+b+(a+m1)*8)
  255. 2550 nextb,a
  256. 2560 gosub1430:gosub740:return
  257. 2570 rem
  258. 2580 rem ****************************
  259. 2590 rem * swap character data subr *
  260. 2600 rem ****************************
  261. 2610 rem
  262. 2620 gosub1430:print"[144]"o$"starting char ";:gosub1550:sc=w
  263. 2630 print:printo$"ending char ";:gosub1550:ec=w
  264. 2640 print:printo$"swap with ";:gosub1550
  265. 2650 fora=0to(ec-sc):forb=0to7
  266. 2660 t=peek(12288+b+(a+w)*8)
  267. 2670 poke12288+b+(a+w)*8,peek(12288+b+(a+sc)*8)
  268. 2680 poke12288+b+(a+sc)*8,t:nextb,a
  269. 2690 gosub1430:gosub740:gosub1070:return
  270. 2700 rem
  271. 2710 rem **************************
  272. 2720 rem * reverse character data *
  273. 2730 rem **************************
  274. 2740 rem
  275. 2750 gosub1430
  276. 2760 print"";:ifyt=0thenprinto$"[144]reverse data"
  277. 2770 print:printo$"starting char ";:gosub1550
  278. 2780 sc=w
  279. 2790 print:print:printo$"ending char ";:gosub1550
  280. 2800 ifw<scthen2750
  281. 2810 ifyt=1thenreturn
  282. 2820 print:print:printo$"  ...reversing...[144]"
  283. 2830 fora=0to(w-sc):forb=0to7
  284. 2840 poke12288+b+(a+sc)*8,255-peek(12288+b+(a+sc)*8):nextb,a
  285. 2850 gosub1430:gosub740
  286. 2860 gosub1070:return
  287. 2870 rem
  288. 2880 rem **************************
  289. 2890 rem * get rom character data *
  290. 2900 rem **************************
  291. 2910 rem
  292. 2920 yt=1:print"[144]":gosub2750:yt=0
  293. 2930 print:printo$"...loading from rom...[144]"
  294. 2940 poke56334,peek(56334)and254
  295. 2950 poke1,peek(1)and251
  296. 2960 fora=sc*8tosc*8+(w-sc)*8+7
  297. 2970 pokea+12288,peek(a+53248):next
  298. 2980 poke1,peek(1)or4
  299. 2990 poke56334,peek(56334)or1
  300. 3000 gosub1430:gosub740:gosub1070:return
  301. 3010 gosub1430
  302. 3020 print""o$;"[144]character number ";
  303. 3030 gosub1550
  304. 3040 print:print:tp=cc:cc=w:gosub1070
  305. 3050 print"":fora=0to7
  306. 3060 printo$;peek(12288+a+(w*8))
  307. 3070 nexta
  308. 3080 print:printo$;"    space to return"
  309. 3090 gosub1390:cc=tp:gosub1070
  310. 3100 gosub1430:gosub740
  311. 3110 gosub1070:return
  312. 3120 rem
  313. 3130 rem ***************************
  314. 3140 rem * decrement character --> *
  315. 3150 rem ***************************
  316. 3160 rem
  317. 3170 cc=cc-1:ifcc<0thencc=255
  318. 3180 gosub1070:return
  319. 3190 rem
  320. 3200 rem ***************************
  321. 3210 rem * increment character --> *
  322. 3220 rem ***************************
  323. 3230 rem
  324. 3240 cc=cc+1:ifcc>255thencc=1
  325. 3250 goto 3180
  326.